
(defun file-dialog (&optional (title nil) change-directory filters)
"Args: &optional filename change-directory (title \"Save\") filters
Presents a file dialog for opening (the default) or saving a file under ms-windows. 
The dialog will be an OPEN dialog by default. It will be a SAVE dialog when TITLE is non-nil.
  
TITLE
is a title string for the SAVE dialog. The title of the open dialog is OPEN, regardless.

CHANGE-DIRECTORY 
is t/nil for whether you want the current directory to change to the file's directory after the dialog is closed (does not change if canceled).

FILTERS
is a string of the form \"Text files (*.txt)|*.txt\" accepting any number of description|mask pairs, with pairs separated by |. Default is:
     \"All Files(*.*)|*.*|ViSta Data Files(*.VDF)|*.vdf|ViSta Applet Files(*.VAF)|*.vaf|ViSta Program Files(*.VIS)|*.vis|Lisp Program Files(*.LSP)|*.lsp|Plain Text Files(*.TXT)|*.txt\" "

  (unless filters (setf filters "All Files(*.*)|*.*|ViSta Data Files(*.VDF)|*.vdf|ViSta Applet Files(*.VAF)|*.vaf|ViSta Program Files(*.VIS)|*.vis|Lisp Program Files(*.LSP)|*.lsp|Plain Text Files(*.TXT)|*.txt"))

  #+msdos(if title 
             (set-file-dialog title change-directory filters)
             (open-file-dialog change-directory filters)))



(defun clean-open-file-dialog (arg)
"Alias for read-file-dialog"
  (apply #'read-file-dialog args))

(defun read-file-dialog (&optional change-directory filters)
"Args: &optional filename change-directory (title \"Save\") filters
Presents a file dialog for opening a file under ms-windows, using filetype filters. Opens, loads and closes file. Returns file.
  
CHANGE-DIRECTORY 
is t/nil for whether you want the current directory to change to the file's directory after the dialog is closed (does not change if canceled).

FILTERS
is a string of the form \"Text files (*.txt)|*.txt\" accepting any number of description|mask pairs, with pairs separated by |. Default is:
     \"All Files(*.*)|*.*|ViSta Data Files(*.VDF)|*.vdf|ViSta Applet Files(*.VAF)|*.vaf|ViSta Program Files(*.VIS)|*.vis|Lisp Program Files(*.LSP)|*.lsp|Plain Text Files(*.TXT)|*.txt\" "

  (unless filters (setf filters "All Files(*.*)|*.*|ViSta Data Files(*.VDF)|*.vdf|ViSta Applet Files(*.VAF)|*.vaf|ViSta Program Files(*.VIS)|*.vis|Lisp Program Files(*.LSP)|*.lsp|Plain Text Files(*.TXT)|*.txt"))

   (open-file-dialog change-directory filters))



(defun clean-set-file-dialog (&rest args)
"Alias for set-file-dialog"
  (apply #'write-file-dialog args))

(defun write-file-dialog (&optional (title nil) change-directory filters)
"Args: &optional filename change-directory (title \"Save\") filters
Presents a file dialog for writing a file under ms-windows. Opens, writes and closes file. Returns file.
  
TITLE
is a title string for the SAVE dialog. The title of the open dialog is OPEN, regardless.

CHANGE-DIRECTORY 
is t/nil for whether you want the current directory to change to the file's directory after the dialog is closed (does not change if canceled).

FILTERS
is a string of the form \"Text files (*.txt)|*.txt\" accepting any number of description|mask pairs, with pairs separated by |. Default is:
     \"All Files(*.*)|*.*|ViSta Data Files(*.VDF)|*.vdf|ViSta Applet Files(*.VAF)|*.vaf|ViSta Program Files(*.VIS)|*.vis|Lisp Program Files(*.LSP)|*.lsp|Plain Text Files(*.TXT)|*.txt\" "

  (unless filters (setf filters "All Files(*.*)|*.*|ViSta Data Files(*.VDF)|*.vdf|ViSta Applet Files(*.VAF)|*.vaf|ViSta Program Files(*.VIS)|*.vis|Lisp Program Files(*.LSP)|*.lsp|Plain Text Files(*.TXT)|*.txt"))
  
  (set-file-dialog title change-directory filters))




(defun yes-or-no-dialog (text &optional (yes t))
"Args: TEXT &optional (YES T)
Default button is YES unless YES is NIL"
  (two-button-dialog text :first-button "Yes" :second-button "No" :first yes))


(defun no-button-dialog (text)
"Args: TEXT"
  (let* ((text (send text-item-proto :new text))0
         (dialog (send dialog-proto :new (list text) :size 400 75)))
    dialog))

#| IN DEFUN0.LSP
defun one-button-dialog 
 
|#

(defun two-button-dialog 
  (text &key (first-button "OK") (second-button "Cancel") (title "Dialog") (first t))
"Args: TEXT &KEY (FIRST-BUTTON \"OK\") (SECOND-BUTTON \"CANCEL\")"
  (let* ((text (send text-item-proto :new text))
         (ok (send modal-button-proto :new first-button
                   :action #'(lambda () t)))
         (no (send modal-button-proto :new second-button
                   :action #'(lambda () nil)))
         (dialog (send modal-dialog-proto :new 
                       (list text (list ok no)) 
                       :default-button (if first ok no)
                       :title title)))
    (send dialog :modal-dialog)))

(defun three-button-dialog 
  (text &key (first-button "OK") (second-button "No") (third-button "Cancel") 
        (default-button) (title "Dialog") (single-line nil))
"Args: TEXT &KEY (FIRST-BUTTON \"OK\") (SECOND-BUTTON \"No\") (THIRD-BUTTON \"CANCEL\") (SINGLE-LINE NIL) (TITLE \"Dialog\""
  (let* ((text (send text-item-proto :new text))
         (ok (send modal-button-proto :new first-button
                   :action #'(lambda () 0)))
         (no (send modal-button-proto :new second-button
                   :action #'(lambda () 1)))
         (cancel (send modal-button-proto :new third-button
                       :action #'(lambda () 2)))
         (dialog (send modal-dialog-proto :new 
                       (list text (if single-line (list ok no cancel)
                                      (list (list (list ok no) cancel))))
                       :default-button ok
                       :title title))
         )
    (send dialog :modal-dialog)))

(defun four-button-dialog 
  (text &key (first-button "OK") (second-button "No") (third-button "Continue") (fourth-button "Cancel") 
        (default-button) (title "Dialog"))
"Args: TEXT &KEY (FIRST-BUTTON \"OK\") (SECOND-BUTTON \"No\") (THIRD-BUTTON \"CONTINUE\") (FOURTH-BUTTON \"CANCEL\")"
  (let* ((text (send text-item-proto :new text))
         (ok (send modal-button-proto :new first-button
                   :action #'(lambda () 0)))
         (no (send modal-button-proto :new second-button
                   :action #'(lambda () 1)))
         (continue (send modal-button-proto :new third-button
                       :action #'(lambda () 2)))
         (cancel (send modal-button-proto :new fourth-button
                       :action #'(lambda () 3)))
         (dialog (send modal-dialog-proto :new 
                       (list text (list ok no) (list continue cancel) )
                       :default-button ok
                       :title title))
         )
    (send dialog :modal-dialog)))

(defun button-dialog (text choice-list action-list 
                                  &key (title "Choose Items") (horizontal nil) (cancel t)
                                  (size nil) (location nil))
"Args: TEXT CHOICE-LIST ACTION-LIST &Key (HORIZONTAL NIL) (CANCEL T) TITLE LOCATION
Presents a modeless button item dialog box. TEXT appears in the dialog box before the choice items, unless NIL. CHOICE-LIST is a list of choice-item strings. ACTION-LIST is a list of action functions, one action for each choice. When CANCEL is T (which it is by default) a CANCEL item is appended to end of each list"
  (let* ((text (if text (send text-item-proto :new text) nil))
         (buttons (mapcar #'(lambda (text action)
                              (send modal-button-proto :new text
                                    :action action))
                          choice-list action-list))
         (canceler (send button-item-proto :new "Cancel" 
                      :action #'(lambda () (send self :cancel))))
         (items (if cancel (combine buttons canceler) buttons))
         (items (if horizontal items (list items)))
         (location (if location location (list (first (floor (* 3/4 (screen-size))))
                                               (second (floor (* 1/4 (screen-size)))))))
         (dialog (send modal-dialog-proto :new 
                       (if text (list text items) (list items))
                       :title title
                       :location location
                       ))
         )
    (defmeth canceler :cancel () (send dialog :close))
    dialog
    ))


#|
(button-dialog nil (list  "?? Help ??" "!! Start !!" "XX Close XX") (list 'applet-get-help 'begin-applet  'cancel) ::title "ViSta Step-by-step Guide" :cancel nil :horizontal t)
|#

(defun choice-item-dialog (text item-string-list action-list 
                               &key (show t) (title "Choose Items") (initial nil)
                              (size nil) (location nil))
"Args: TEXT ITEM-STRING-LIST ACTION-LIST &Key SHOW TITLE SIZE LOCATION INITIAL
Presents a modeless choice item dialog box. TEXT appears in the dialog box before the choice items, unless NIL. ITEM-STRING-LIST is a list of choice-item strings. ACTION-LIST is a list of action functions, one for each choice. INITIAL is a number specifying the initial choice (nil - none checked - by default)."
  (let* ((text (if text (send text-item-proto :new text)) nil)
         (choice (send choice-item-proto  :new (combine item-string-list " ")
                       :value (if initial initial (length item-string-list))
                       :action #'(lambda () (send self :do-choice-action))))
         (cancel (send button-item-proto :new "Cancel" 
                      :action #'(lambda () (send self :close))))
         (dialog (send dialog-proto :new 
                       (if text (list text choice) (list choice))
                       :show show :title title
                       :size size :location location)) )
    (defmeth choice :do-choice-action ()
      (eval (select action-list (send choice :value))))
   ; (defmeth choice :cancel () 
   ;   (send dialog :close))
    (if (send dialog :size)
        (send dialog :size (first (floor (* 4/5 (send dialog :size))))
              (second (send dialog :size)))
        (send dialog :show-window))
    (apply #'send dialog :size (- (send dialog :size) '(0 24)))
    dialog))

(defun list-dialog 
  (text item-string-list action-list 
                    &key (show t) (title " ") (initial nil)
                    (size nil) (location nil) (close nil close?) 
                    (header1 nil) (header2 nil))
"Args: TEXT ITEM-STRING-LIST ACTION-LIST &Key SHOW TITLE SIZE LOCATION INITIAL CLOSE
Presents a modeless choice dialog box containing a list of choices, of which one may be choosen. ITEM-STRING-LIST is a list of strings which are the choice items. ACTION-LIST is a list of function statements of the actions taken by each choice. The two lists must be the same length. TEXT appears in the dialog box before the choice items, unless NIL. Dialog box has title TITLE. Choice INITIAL is shown checked (nil - none checked - by default). 
  The dialog can have a close toggle and a close box (the toggle being in the body of the dialog). When the CLOSE keyword is not used the dialog has the usual close box and no toggle. When CLOSE is T there are two ways to close the dialog. When CLOSE is NIL, there is no way to close the dialog other than by sending the dialog the remove message."
  (let* ((title-item (send text-item-proto :new (string-upcase title)))
         (text (if text (send text-item-proto :new text)) nil)
         (closer (send button-item-proto :new "Cancel" 
                      :action #'(lambda () (send self :close))))
         (choice (send list-item-proto  :new item-string-list
                       :action #'(lambda (arg) (send self :do-choice-action))
                       :size (if size (- size '(24 24)) nil)))
         (dialog (send dialog-proto :new 
                       (if text 
                           (if close 
                               (list text choice closer)
                               (list text choice))
                           (if close 
                               (list choice closer)
                               (list choice)))
                       :show show :title title 
                       :size size :location location)) )
    (when (and (not close) close?)
          (defmeth dialog :close ()))
    (send choice :selection 0)
    (defmeth closer :close () (send dialog :close))
    (defmeth choice :do-choice-action ()
      (eval (select action-list (send choice :selection))))
    (defmeth choice :cancel () (send dialog :close))
    (unless show (send dialog :show-window))
    dialog))




(defun double-list-dialog (topics subtopics actions
                                  &key (show t) (title " ") 
                                  (header1 "TOPICS") (header2 "SUBTOPICS")
                                  (location nil) 
                                  (choice-to-show-vista-at-close nil)
                                  (choice-to-show-dialog-again-at-startup nil) 
                                  (initial nil)
                                  (max-list-length-shown 10)
                                  (first nil))
  "Args: TOPICS SUBTOPICS ACTIONS &Key (HEADER1 \"Topics\") (HEADER2 \"Topics\") (INITIAL (list nil nil)) FIRST SHOW TITLE LOCATION CHOICE-TO-SHOW-DIALOG-AT-STARTUP CHOICE-TO-SHOW-VISTA-AT-CLOSE, where TOPICS is a list of strings, SUBTOPICS is a list of lists of strings, and ACTIONS is a list of lists of functions. The number of subtopic and action lists must both equal the number of topics strings.
  Presents a modeless choice dialog box displaying two columns of items for the user to click on. The left column is the list of TOPICS strings. The right column is a sublist selected from SUBTOPICS - the i'th subtopic list is shown when the i'th topic item is clicked on in the left column. When the j'th element of the i'th subtopic list is clicked on, the corresponding ACTION function is evaluated. 
  One or two toggles will be included when the CHOICE-TO items are used. Their argument may be either a logical value or a list of two logical values. The items will be shown if the (first) value is t, and it will be check-marked at display-time if the second value is t. The indicated action will be taken at close if the toggle is t at close.
  The following may not work as described:
  When FIRST is NIL, clicking a topic displays the appropriate list of subtopics. When FIRST is T, clicking a topic displays the appropriate list of subtopics, and then selects the first subtopic and performs its action. 
  INITIAL determines which TOPIC, SUBTOPIC, and ACTION are activated when the dialog box is initially shown, if any. INITIAL is either a single element or a list of one, two or three elements. An element can be T or NIL or a non-negative integer. When INITIAL is NIL (or not used), there is no initial action. When INITIAL is N (an integer) the N'th topic is selected. When INITIAL is '(N M), the N'th topic's M'th subtopic is selected, but no action is taken. When INITIAL is '(N M T), the N'th topic's M'th subtopic is selected and the subtopic's action is taken. "

  (let* ((choice1 choice-to-show-vista-at-close)
         (choice2 choice-to-show-dialog-again-at-startup)
         (tog1-listp (and (listp choice1) (> (length choice1) 0)))
         (tog2-listp (and (listp choice2) (> (length choice2) 0)))
         (show-tog1 (if tog1-listp
                         (first choice-to-show-vista-at-close) 
                         choice-to-show-vista-at-close))
         (show-tog2 (if tog2-listp
                        (first choice-to-show-dialog-again-at-startup)
                        choice-to-show-dialog-again-at-startup))
         (tog1-on (if tog1-listp (second choice-to-show-vista-at-close) nil))
         (tog2-on (if tog2-listp (second choice-to-show-dialog-again-at-startup) nil))
         (header1-item (if header1 (send text-item-proto :new header1)) nil)
         (header2-item (if header2 (send text-item-proto :new header2)) nil)
         (toggle1 (send toggle-item-proto :new 
                        "Show ViSta When This Panel is Closed (Exit ViSta Otherwise)"
                        :value tog1-on))
         (toggle2 (send toggle-item-proto :new "Show This Panel Next Time ViSta is Run."
                        :value tog2-on))
         (num-items (mapcar #'length subtopics))
         (num-topics (length topics))
         (max-lines max-list-length-shown)
         (size '(200 200)) ;actually used for minimum height only
         (num-choices (min max-lines (max num-topics num-items)))
         (num-blank-lines1 (- num-choices (length topics)))
         (num-blank-lines2 (- num-choices (length (first subtopics))))
         (blank-lines (repeat " " num-choices))
         (topic-lines (if (> num-blank-lines1 0) 
                          (combine topics (repeat " " num-blank-lines1))
                          topics))
         (item-lines  (if (> num-blank-lines2 0) 
                          (combine (first subtopics) (repeat " " num-blank-lines2))
                          subtopics))
         (text-height (+ (send *workmap* :text-ascent) (send *workmap* :text-descent) ))
         (widths1 (sort-data (mapcar #'(lambda (str) 
                                         (send *workmap* :text-width str)) 
                                     topics)))
         (widths2 (sort-data (mapcar #'(lambda (str) 
                                         (send *workmap* :text-width str))
                                     (combine subtopics))))
         (text-width1 (select widths1 (floor (* .8 num-topics))))
         (text-width2 (select widths2 (floor (* .8 (sum num-items)))))
        ; (text-width1 
        ;  (ceiling (* .8 (max (mapcar #'(lambda (str)
        ;                            (send *workmap* :text-width str)) 
        ;                        topics)))))
        ; (text-width2 
        ;  (ceiling (* .8 (max (mapcar #'(lambda (str)
        ;                            (send *workmap* :text-width str)) 
        ;                        (combine subtopics))))))
         (padding1 (if (> num-topics (1- max-lines))  24 24)) ; 45 10
         (padding2 (if (> num-choices (1- max-lines)) 24 24)); 45 10
         (box-width1 (+ text-width1 padding1))
         (box-width2 (+ text-width2 padding2))
         (box-height (min (- (second size) 70) (+ 10 (* text-height (1- num-choices)))))
         (choice1 (send list-item-proto :new topic-lines :size (list box-width1 box-height)))
         (choice2 (send list-item-proto :new item-lines  :size (list box-width2 box-height)))
         (dialog-size  (list (+ box-width1 box-width2 
                                (if (> num-topics max-lines) 32 32) )
                             (+ box-height 54
                                (if show-tog1 24 0)
                                (if show-tog2 24 0))))
         
         (dialog (send dialog-proto :new 
                       (remove 'nil 
                               (list
                                (list (list 
                                            (if header1 header1-item)
                                            choice1)
                                           (list
                                            (if header2 header2-item)
                                            choice2))
                                (if show-tog1 toggle1)
                                (if show-tog2 toggle2)
                                ))
                       :show nil
                       :title (if title title " ")
                       :size dialog-size
                       :location location))
         
         (prev-selection 0))
    
    (send choice1 :slot-value 'size (list box-width1 box-height))
    (defmeth choice1 :size (&optional (pixels nil set))
      (if set (setf (slot-value 'size) pixels)) 
      (slot-value 'size)) 

    (send choice2 :slot-value 'size (list box-width2 box-height))
    (defmeth choice2 :size (&optional (pixels nil set))
      (if set (setf (slot-value 'size) pixels)) 
      (slot-value 'size)) 

    (send choice1 :add-slot 'topics topics)
    (defmeth choice1 :topics (&optional (alist nil set))
      (if set (setf (slot-value 'topics) alist)) 
      (slot-value 'topics))
    
    (send choice2 :add-slot 'topics subtopics)
    (defmeth choice2 :topics (&optional (alist nil set))
      (if set (setf (slot-value 'topics) alist)) 
      (slot-value 'topics))
    
    (send dialog :add-slot 'topics topics)
    (defmeth dialog :topics (&optional (alist nil set))
      (if set (setf (slot-value 'topics) alist)) 
      (slot-value 'topics))

    (send dialog :add-slot 'subtopics subtopics)
    (defmeth dialog :subtopics (&optional (alist nil set))
      (if set (setf (slot-value 'subtopics) alist)) 
      (slot-value 'subtopics))
    
    (send dialog :add-slot 'actions actions)
    (defmeth dialog :actions (&optional (alist nil set))
      (if set (setf (slot-value 'actions) alist)) 
      (slot-value 'actions))

    (send dialog :add-slot 'lists (list choice1 choice2))
    (defmeth dialog :lists (&optional (objid-list nil set))
      (if set (setf (slot-value 'lists) objid-list)) 
      (slot-value 'lists))

    (send dialog :add-slot 'showing nil)
    (defmeth dialog :showing (&optional (nilt nil set))
      (if set (setf (slot-value 'showing) nilt)) 
      (slot-value 'showing))

    (send choice1 :add-slot 'previous-selection nil)
    (defmeth choice1 :previous-selection (&optional (alist nil set))
      (if set (setf (slot-value 'previous-selection) alist)) 
      (slot-value 'previous-selection))

    (send dialog :add-slot 'toggle1-value (send toggle1 :value))
    (defmeth dialog :toggle1-value  (&optional (logical nil set))
      (if set (setf (slot-value 'toggle1-value) logical)) 
      (slot-value 'toggle1-value))

    (send dialog :add-slot 'toggle2-value (send toggle2 :value))
    (defmeth dialog :toggle2-value (&optional (logical nil set))
      (if set (setf (slot-value 'toggle2-value) logical)) 
      (slot-value 'toggle2-value))

    (defmeth choice1 :do-action ()
;(PRINT (LIST "choice1 :do-action" ))
      (let* ((iselect (send choice1 :selection))
             (previous-selection (send choice1 :previous-selection))
             (num-prev-items (if previous-selection
                                 (select num-items previous-selection)
                                 0))
             (subtopics (if iselect
                        (select (send choice2 :topics) iselect)
                        nil))
             (nitems (length subtopics))
             )
        (mapcar #'(lambda (i)       
                    (send choice2 :set-text i " ")
                    (when (< i nitems)
                          (send choice2 :set-text i (select subtopics i))
                          ))
                (iseq (max nitems num-prev-items)))
        
        (send choice1 :previous-selection iselect)
        
        (send choice2 :selection 0);nil for no selection, 0 for first selection
        (when (and first iselect) (send choice2 :do-action))
        ))

    (defmeth choice2 :do-action (&optional (act t))

;(PRINT (LIST "choice2 :do-action" act))
      (let* ((iselect (send choice1 :selection))
             (jselect (send choice2 :selection)))
        (when (and iselect (not jselect)) (setf jselect 0))
        (when (and iselect jselect)
              (cond 
                ((<= jselect (select num-items iselect))
                 (when act (eval (select (select (send dialog :actions) iselect) jselect))))
                (prev-selection ;this statement is nonsense
                 (send self :selection prev-selection))
                (t (send self :selection 0)))
              (setf prev-selection (send self :selection)))))
    

    (defmeth dialog :do-action (&optional item-i item-j act)

;(PRINT (LIST "dialog :do-action" item-i item-j act))
      (send choice2 :selection nil)
      (send choice1 :selection nil)
      (when item-i (send choice1 :selection item-i) ;selects and highlights
            (when item-j (send choice1 :do-action) ;shows appropriate second list
                  (send choice2 :selection item-j) ;selects appropriate item of second list
                  (when act (send choice2 :do-action act)))))
          

    (defmeth dialog :show-window (&optional (i 0) (j 0) &key (do-action nil))
;(PRINT (LIST "DIALOG SHOW WINDOW" I J DO-ACTION))
;(break)
      (call-next-method);shows window when already created
      (cond
        ((and i j) (send self :do-action i j do-action))
        ((and i (not j)) (send self :do-action i nil do-action)))
      (call-next-method)
      (send self :showing t)
      dialog)
 

    (defmeth dialog :hide-window ()
      (call-next-method)
      (send self :showing nil))

    
    (send choice1 :selection 
      (cond
        ((listp initial) (first initial) )
        (initial initial)
        (t 0)))

    (send choice2 :selection
      (cond
        ((listp initial) 
         (case (length initial) 
           (1 0)
           (t (second initial))))
        (t 0)))

    (when (and (listp initial)
               (= (length initial) 3))
          (send choice2 :do-action t))

    (defmeth toggle2 :do-action ()
      (send dialog :toggle2-value (send toggle2 :value))
      (send dialog :dont-show-again))

    (defmeth dialog :toggle-value ()
      (send toggle2 :value))

   ; (defmeth toggle1 :do-action ()
   ;   (send dialog :toggle1-value (send toggle1 :value))
   ;   (if (send toggle1 :value)
   ;       (show-vista)
   ;       (hide-vista)))

    (defmeth dialog :close ()
      (let* ((tog1 (send dialog :toggle1-value))
             (tog2 (send dialog :toggle2-value)))
        (if *help-window* (send *help-window* :close))
        (send *help-control-panel* :showing nil)
        (setf *help-control-panel* nil)
;(print (list "toggle1 value is " (send toggle1 :value)))
        (if (send toggle1 :value) 
            (show-vista) 
            (exit))
        (send *vista* :show-first-help (send toggle2 :value))
        (call-next-method)
        (send choice1 :select 0)
        (send choice2 :select 0)
        ))
;(print (list "dialog" show (length initial) initial))
    (when show (apply #'send dialog :show-window 
                     (case (length initial)
                       (0 (list nil nil ':do-action nil))
                       (1 (list (first initial) nil ':do-action nil))
                       (2 (list (first initial)
                                (second initial) 
                                ':do-action nil))
                       (3 (list (first initial)
                                (second initial) 
                                ':do-action (third initial))))))
    dialog))







(defun top-level-data-error (&optional text)
  (send *workmap* :postpone-redraw nil)
  (error-message (if text (strcat text "Processing Stopped") "Processing Stopped"))
  (top-level))

(defun vista-warning-dialog (string)
"Arg: STRING
Presents vista warning dialog displaying STRING."
  (error-message string))

(defun vista-error-dialog (string)
"Arg: STRING
Presents vista fatal error dialog displaying STRING."
  (error-message string nil t))

(defun vista-fatal-dialog (string)
"Arg: STRING
Presents vista fatal error dialog displaying STRING."
  (error-message string nil t))


(defun yes-or-no-error-message (string)
"Arg: STRING
Presents vista warning dialog displaying STRING with yes and no buttons."
  (error-message string t nil t))

(defun fatal-message (string)
  (error-message string nil t)
  (error string)
  (top-level)
  )

(defun warning-message (string)
  (error-message string nil nil)
  )

(defun error-message (string &optional (error t) fatal yesno)
"Args: STRING &OPTIONAL ERROR FATAL YESNO
Presents error dialog displaying STRING.  Called error if error T or fatal if fatal is T. Has yes and no buttons if yesno is T, OK button otherwise."
  (let* ((message (format nil "ViSta Warning Message:~%")) 
         (pretty-string)
         )
    (when error
          (sysbeep)
          (setf message (format nil "ViSta Error Message - Computations Interrupted.~%"))) 
    (when fatal
          (sysbeep)
          (setf message (format nil "ViSta Fatal Error Message - Computations Terminated.~%"))
          )
    (sysbeep)
    (setf pretty-string (strcat message (pretty-print string)))
    (if yesno
        (two-button-dialog pretty-string :first-button "Stop" :second-button "Continue")
        (message-dialog pretty-string))
    (when fatal (top-level))))

(defun vista-dialog (string)
  (let* ((message (format nil "ViSta Message:~%")) 
         (pretty-string))
    (setf pretty-string (strcat message (pretty-print string)))
    (message-dialog pretty-string)))
